home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Belgian Amiga Club - ADF Collection
/
BS1 part 05.zip
/
BS1 part 5
/
ANC_UTULITYS_16.adf
/
Check.arc
/
CheckHop
(
.txt
)
< prev
next >
Wrap
AmigaBASIC Source Code
|
1988-09-21
|
7KB
|
236 lines
SAY TRANSLATE$("")
SCREEN 2,640,200,3,2
WINDOW 2,"",,0,2
DIM red(44),s(7,7),s1(47),s2(47),s3(47),s4(47)
ON ERROR GOTO EH
GOSUB MakeScreen
Start:Numleft=48
FOR J=6 TO 7:FOR i=0 TO 7:s(i,J)=1:NEXT i,J
FOR J=0 TO 1:FOR i=0 TO 7:s(i,J)=1:NEXT i,J
FOR J=0 TO 7:FOR i=0 TO 1:s(i,J)=1:NEXT i,J
FOR J=0 TO 7:FOR i=6 TO 7:s(i,J)=1:NEXT i,J
GOSUB PlaceCheckers
IF qq$="V" THEN View
150 LOCATE 1,1:PRINT SPACE$(80):LOCATE 1,1:PRINT "From ";
160 IF MOUSE(0)<>0 THEN 160
170 IF MOUSE(0)=0 THEN 170
col=MOUSE(1):row=MOUSE(2)
IF col>19 AND col<106 AND row>126 AND row<146 THEN Win
GOSUB Calc
IF col<0 OR col>7 OR row<0 OR row>7 THEN 150
PRINT col;" ";row:e=col:h=row
IF e<0 OR h<0 THEN BEEP:GOTO 150
IF s(e,h)=0 THEN BEEP:GOTO 150
180 LOCATE 1,30:PRINT SPACE$(15):LOCATE 1,30:PRINT "To ";
IF MOUSE(0)=-1 THEN
185 IF MOUSE(0)=0 THEN 205 :ELSE 185
END IF
190 IF MOUSE(0)<>0 THEN 190
200 IF MOUSE(0)=0 THEN 200
205 col=MOUSE(1):row=MOUSE(2)
IF col>19 AND col<106 AND row>126 AND row<146 THEN Win
GOSUB Calc
a=col:b=row:IF a=e AND b=h THEN 180
IF col<0 OR col>7 OR row<0 OR row>7 THEN BEEP:GOTO 150
IF s(col,row)=1 THEN BEEP:SAY TRANSLATE$("You must land in a blank space."):GOTO 150
m1=(e+a)/2:m2=(h+b)/2
IF e=a OR b=h OR ABS(e-a)<>2 OR ABS(h-b)<>2 OR s(m1,m2)=0 THEN SAY TRANSLATE$("You must jump dyagnauly over a checker"):GOTO 150
PRINT col;" ";row
s(e,h)=0:s(m1,m2)=0:s(a,b)=1
GOSUB move
GOTO 150
Win:
Jumped=48-Numleft
CALL SayNumber(Jumped,J$)
SAY TRANSLATE$("You succesfully jumped over "+J$+" checkers")
CALL SayNumber(Numleft-1,J$)
SAY TRANSLATE$("and had "+J$+" jumps remaining.")
IF Jumped<25 THEN
SAY TRANSLATE$("I'm sorry, but you really didn't do very good.")
END IF
IF Jumped>24 AND Jumped<30 THEN
SAY TRANSLATE$("You did o.k.")
END IF
IF Jumped>29 AND Jumped<40 THEN
SAY TRANSLATE$("You did a pretty good job.")
END IF
IF Jumped>39 AND Jumped<45 THEN
SAY TRANSLATE$("That is terrific. I'm proud of you.")
END IF
IF Jumped>44 AND Jumped<47 THEN
SAY TRANSLATE$("Wow. That is really sooper. That is great. Thank you for playing")
END IF
IF Jumped>46 THEN
SAY TRANSLATE$("I am flabbergasted. I don't know what to say. That is terrific. Congratulations on a fine job.")
END IF
LOCATE 10,1:PRINT "Save Game?":PRINT "(Y/N)"
SAY TRANSLATE$("Would you like to save this game")
315 a$=UCASE$(INKEY$):IF a$="" OR (a$<>"Y" AND a$<>"N") THEN 315
IF a$="Y" THEN
LOCATE 10,1:PRINT SPACE$(10):PRINT SPACE$(5)
SAY TRANSLATE$("What would you like to name it")
LOCATE 10,1:PRINT "Name:":INPUT GameName$
OPEN GameName$ FOR OUTPUT AS 1
PRINT #1,Numleft
FOR i=0 TO 47-Numleft
PRINT #1,s1(i),s2(i),s3(i),s4(i)
NEXT i
CLOSE #1
END IF
LOCATE 10,1:PRINT "Play Again?":PRINT "(Y/N) "
SAY TRANSLATE$("Would you like to play again")
320 a$=UCASE$(INKEY$):IF a$="" OR (a$<>"Y" AND a$<>"N") THEN 320
IF a$="Y" THEN
CLS:GOSUB Ask
GOSUB draw
FOR y=0 TO 7:FOR x=0 TO 7:s(x,y)=0:NEXT x,y
GOTO Start
ELSE
SAY TRANSLATE$("by by."):SYSTEM
END IF
move:
ee=e*50+160
hh=h*20+31
aa=a*50+160
bb=b*20+31
LINE(ee-24,hh-9)-(ee+24,hh+9),6,bf
PUT(aa-12,bb-5),red,PSET
SOUND 10000,0.05
cc=m1*50+160
rr=m2*20+31
LINE(cc-24,rr-9)-(cc+24,rr+9),6,bf
Numleft=Numleft-1
LOCATE 5,1:PRINT "Jumps: ";48-Numleft
LOCATE 7,1:PRINT "To go: ";Numleft-1
g=47-Numleft
s1(g)=e:s2(g)=h
s3(g)=a:s4(g)=b
IF Numleft=1 THEN Win
RETURN
PlaceCheckers:
FOR y=0 TO 7
FOR x=0 TO 7
xx=x*50+160
yy=y*20+31
IF s(x,y)=1 THEN PUT(xx-12,yy-5),red,PSET
NEXT x,y
RETURN
Calc:
IF col>135 AND col<185 THEN col=0
IF col>185 AND col<235 THEN col=1
IF col>235 AND col<285 THEN col=2
IF col>285 AND col<335 THEN col=3
IF col>335 AND col<385 THEN col=4
IF col>385 AND col<435 THEN col=5
IF col>435 AND col<485 THEN col=6
IF col>485 AND col<535 THEN col=7
IF row>21 AND row<41 THEN row=0
IF row>41 AND row<61 THEN row=1
IF row>61 AND row<81 THEN row=2
IF row>81 AND row<101 THEN row=3
IF row>101 AND row<121 THEN row=4
IF row>121 AND row<141 THEN row=5
IF row>141 AND row<161 THEN row=6
IF row>161 AND row<181 THEN row=7
RETURN
View:
LOCATE 1,1:INPUT "Name of game";GameName$
OPEN GameName$ FOR INPUT AS 1
INPUT #1,Numleft
z=47-Numleft:Numleft=48
FOR i=0 TO z
INPUT #1,s1(i),s2(i),s3(i),s4(i)
NEXT i
CLOSE #1
FOR i=0 TO z
e=s1(i)
h=s2(i)
a=s3(i)
b=s4(i)
m1=(e+a)/2:m2=(h+b)/2
s(e,h)=0:s(m1,m2)=0:s(a,b)=1
GOSUB move
325 a$=INKEY$:IF a$="" THEN 325
IF a$=CHR$(27) THEN 150
NEXT i
GOTO Win
Ask:
LOCATE 19,26:PRINT "Press 'P' to play a game"
LOCATE 21,26:PRINT "Press 'V' to view a game"
330 qq$=UCASE$(INKEY$):IF qq$="" OR (qq$<>"P" AND qq$<>"V") THEN 330
IF qq$="V" THEN
CLS
LOCATE 5,2:PRINT "While viewing a game you may press 'ESC' to start playing at a certain point."
LOCATE 7,14:PRINT "Press any other key to advance to the next move"
LOCATE 21,32:PRINT "Press any Key"
335 a$=INKEY$:IF a$="" THEN 335
END IF
RETURN
MakeScreen:
LOCATE 2,35:PRINT "Checker Hop"
PRINT TAB(39);"by"
PRINT TAB(35);"Steve Carr"
LOCATE 7,5:PRINT "The object of this game is to remove as many checkers as possible"
PRINT TAB(5);"by diagonal jumps (as in standard checkers)"
LOCATE 10,3:PRINT "TO move - click the piece you want to move and then click on the spot"
PRINT TAB(13);"where you want it"
PRINT TAB(8);"Or - click the piece you want to move, hold the button down,"
PRINT TAB(13);"and let go of it over the spot you want the checker"
LOCATE 15,22:PRINT "To give up click in the give up box"
LOCATE 17,6:PRINT "TO cancel a move after choosing (from) - click in the brown area"
GOSUB Ask
PALETTE 0,0.6,0.33,0 'brown
PALETTE 1,0.6,0.33,0 'brown
PALETTE 2,0.8,0,0 'red
PALETTE 4,1,0.4,0 'orange
PALETTE 6,0.8,0.8,0.8 'light grey
PALETTE 7,0,0,0 'black
COLOR 7,6:CLS
CIRCLE(162,32),14,7
PAINT (162,32),7,7
CIRCLE (160,31),14,2
PAINT (160,31),4,2
CIRCLE (160,31),14,7
CIRCLE (160,31),9,7
PAINT(160,31),2,7
GET(146,25)-(176,38),red
draw:COLOR 7,0:CLS
LINE(19,126)-(106,146),7,b
LOCATE 17,7:PRINT "Give"
LOCATE 18,8:PRINT "Up"
COLOR 1,0
LINE(136,22)-(534,180),6,bf
FOR i=21 TO 181 STEP 20
LINE(135,i)-(535,i),7
NEXT i
FOR i=135 TO 535 STEP 50
LINE(i,21)-(i,181),7
NEXT i
LINE(134,21)-(134,181),7
LINE(535,21)-(551,26),7
LINE -(551,186),7
LINE -(148,186),7
LINE -(135,181),7
PAINT(549,30),7,7
COLOR 7,0
RETURN
EH:
SAY TRANSLATE$("That file does not exist. Program will restart."):CLEAR:RUN
SUB SayNumber(a,talk$) STATIC
IF a<10 THEN talk$=STR$(a)
a$=STR$(a)
a1$=LEFT$(a$,1)
a2$=RIGHT$(a$,1)
IF a>9 AND a<20 THEN talk$=a2$+" teen"
IF a=10 THEN talk$="ten"
IF a=11 THEN talk$="eh-lehven"
IF a=12 THEN talk$="twelve"
IF a=13 THEN talk$="thirteen"
IF a=15 THEN talk$="fifteen"
IF a>19 AND a<30 THEN talk$="twenty "+a2$
IF a>29 AND a<40 THEN talk$="thirty "+a2$
IF a>39 AND a<50 THEN talk$="fourty "+a2$
IF RIGHT$(talk$,1)="0" THEN talk$=LEFT$(talk$,LEN(talk$)-1)
END SUB